perm filename ALPHA.OLD[P11,LCS] blob sn#581886 filedate 1981-04-28 generic text, type T, neo UTF8
C****** FOR LISTS OF LETTERS, ETC. AND TRILL *******
	SUBROUTINE ALPHA
	INTEGER FNAME,POS
	DIMENSION FNAME(4)
	COMMON /PLTR/IPLT,RHT,DIS /FONT/JFONT /NFONT/NFONT
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) 
	COMMON/ALF/INP(10),OLDX /OLDTOP/OLDY
       EQUIVALENCE(J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
	1(R8,RJQ(6)),(NRJ,RJQ(8)),(JX,JQ(11)),
	1(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
	1,(J6,JQ(4)),(R7,RJQ(5)),(R4,RJQ(2)),(IFNT,JQ(13)),(J11,JQ(9)),
	1(RY,JQ(16)),(RX,JQ(17)),(RZ,JQ(18)),(RW
	1,JQ(19)),(RB,JQ(20)),(R,RJQ(20)),(FILL,RJQ(19)),(R9,RJQ(7))
	1,(JTR,RJQ(17)),(RF,RJQ(15)),(JR3,RJQ(14)),(R3,RJQ(1))
	1,(R10,RJQ(8)),(R11,RJQ(9)),(R12,RJQ(10))
	COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,POS
	DATA R4X/-2.1/,IFNT/1/,BLANK/0.7/,NFONT/'BDR40'/
	1,FNAME/'PRIM0','BDR40','BDI40','BDL40'/
C  SEE NEW SIZE FOR 'BLANK'=.7 (OLD SIZE=1.0, CHANGE IN DDT IF NECESSARY)

	IF(JA.EQ.7)GO TO 20
	JTR=99
	IF(R5.GE.100)R5=R5-100
C >100 FOR TEXT IN ORCH SCORES FOR ALL SEP. PARTS.
C  PRIMITIVE IS DEFAULT FONT.  #=SET BACK TO PRIM.
C ONLY 11 LETTERS WITHOUT FONT RESET.
	JF=-JFONT
	IF(JFONT.GE.0)GO TO 540
	JFONT=1
	NFONT=FNAME(JF)
	GO TO 54
540	IF(NFONT.EQ.'PRIM0')GO TO 54
	IF(NFONT.EQ.'BDI40')GO TO 54
	NFONT='BDR40'
C  THE ABOVE IN CASE FONT IS NOT ESTABLISHED.
54	R=19.7*R5*RSTJ2
	RB=J3
	RW=R4
	J9=0
C J9=0 AVOIDS ROTATION IN 'CLEFS'
	DO 50 KA=4,6
	NXZ=-1
	RZ=RJQ(KA)
CC	JY=RZ
CC	IF(JY.NE.RZ)GO TO 130
CC	IF(JY.EQ.RZ)GO TO 13
C  WILL LOSE ON "0AB0" IN OLD FILES**************
CC	IF(JY.GT.999999)GO TO 13
CC130	RZ=100.*RZ
C  FOR OLD FORMAT OF CODE 16
13	JY=RZ+.2
	JX=1000000
	DO 53 LA=1,4
	J5=JY/JX
	J5X=J5
	R3=J3
	IF(J5.EQ.99)GO TO 55
73	IF(KFNT)IFNT=1
C READS OLD SYS. AND NEW AUTOMATIC LWR CASE.
	IF(J5.LT.70)GO TO 72
	KFNT=-1
C  SETS AUTOMATIC LOWER CASE FLAG.
	IFNT=-1
C  60 ADDED FOR LOWER CASE LETTERS.
	J5=J5-60
C NO MORE IN THIS WD.
72	IF(J5.LT.48)GO TO 1
	IF(J5.NE.48)GO TO 172
	NFONT='BDL40'
	IF(JFONT.LT.0)GO TO 9
	GO TO 11
172	GO TO(2,3,9,4,5),J5-49
C SWITCHES FOR DIFF. FONTS.(55 MAKES ')48=UPR,49=LWR,50=BDR,51=BDI,52=PRM
C  ********* UPPER AND LOWER NUMBERS(48,49) NO LONGER NEEDED.(SEE 73 ↑)
	IF(J5.GT.55)GO TO 10
	J5=36
	R4=R4+2.9*R5
C  55 WILL MAKE ' --- 56=?  57=! (THEY COME AFTER y z IN BDR46)
	GO TO 1
10	J5=J5+6 
	NRX=NFONT
	NXZ=0 
	NFONT='BDR40'
	NJF=JFONT
	JFONT=-1
	GO TO 1
2	NFONT='BDR40'
C  &=NON-ITALICS  --  JFONT IS TEMPORARY SWITCH  5/74
	IF(JFONT.LT.0)GO TO 9
	GO TO 11
CC	GO TO 8
3	NFONT='BDI40'
C  @=51=ITALICS
	IF(JFONT.LT.0)GO TO 9
C  TYPE '44 -1' TO MAKE ALL FONTS INTO 'PRIM'
CC8	IF(IFNT.EQ.0)IFNT=-1
	GO TO 11
4	FILL=-2
	GO TO 11
5	FILL=0
	GO TO 11
9	NFONT='PRIM0'
	GO TO 11
1	IF(J5.LT.70)GO TO 12
	IF(J5.GE.76)GO TO 12
	IF(J5.NE.75)GO TO 112
	J5=70
	GO TO 12
112	NFONT='BDI40'
	J5=J5-6
	GO TO 71
12	J5OLD=J5
	IF(J5.LT.64)GO TO 212
	J5X=J5
	IF(J5.LE.65)J5X=J5X-6
	IF(J5.EQ.70)J5X=J5X-1
	J5=J5X
212	CALL SPACER(J5,IFNT,RB,R)
	J5=J5OLD
	IF(J5.GT.60)GO TO 71
C  NOW 62=?  63=!  IN BDR46
	IF(J5-47)7,6,11
7	IF(R11.NE.0.AND.R12.EQ.0)GO TO 79
	IF(JFONT)78,78,77
79	R9=R11
	J9=-1
C  FOR ROTATION, IF ANY.  R11=ROTATION(CLOCKWISE) IN DEGREES.
	GO TO 77
277	IF(NFONT.NE.'PRIM0')GO TO 70
	IF(IFNT.GE.0)GO TO 30
	IF(J5.GE.10)GO TO 71
	GO TO 30
177	J5=J5+22
C (=62 )=63 IN BDI  (BDI46)
	NRX=NFONT
C  SAVE OLD FILE NAME
	NFONT='BDI40'
	NJF=JFONT
C SAVE FONT FLAG
	NXZ=0
C FLAG TO GET BACK RIGHT FLAGS BEFORE 30
	GO TO 71
78	IF(IPLT.GE.0)GO TO 30
C  JFONT=0 FOR FIXED WIDTH OF FONTS.  = AND ONLY DPYS PRIMITIVE.
CC	J5=J6
CC	IF(IFNT.EQ.0)GO TO 30
CC77	IF(J5.GE.36)GO TO 30
77	IF(J5.LT.36)GO TO 277
	IF(J5.EQ.40.OR.J5.EQ.41)GO TO 177
C FOR LEFT AND RIGHT PARENTH.
	IF(J5.NE.43)GO TO 30
C ASTERISK
C  PUNCTUATION AND SPACE.
	IF(NFONT.EQ.'PRIM0')GO TO 30
	IF(NFONT.EQ.'BDI40')GO TO 77
	NRX=NFONT
	NXZ=0
	NJF=J5
	NFONT='BDI40'
777	J5=69
	GO TO 71
CZ	IF(IFNT.GE.0)GO TO 30
CC*** WAS (IFNT.EQ.1) ????  1/76
CZ	IF(J5.LT.10)GO TO 30
C  JUMP TO USE UPPER CASE PRIM. LOWER CASE STARTS IN PRIM1.
CZ	GO TO 71
70	IF(J5.LE.9)GO TO 71
	IF(IFNT.LT.0)J5=J5+26
71	RX=R6
	R6=R5*.28
C  .29 IS SIZE FACTOR -- PERHAPS CHANGE SIZE IN FONT TO =1.
	RY=R7
	R7=R6
	RZ=R8
	R4=R4+R4X
C  SHIFTS DOWN ??? WHY NOT GET RID OF THIS.??
	J8=FILL
	NRJ=NFONT
C  GETS RIGHT FILE
	R8=0
C  TO AVOID THICKENER IN 'CLEFS'
	JA=12
C  ANY NON-11 NUMBER .GT.10 WILL DO.
	CALL CLEFS
	R6=RX
	R7=RY
	R8=RZ
C  PUTS BACK RIGHT STUFF
	IF(NXZ.LT.0)GO TO 6	
	NFONT=NRX
	JFONT=NJF
	GO TO 6

30	J7=0
	R6=R5
	CALL PNUM
C  47=BLANK  (WAS 99)
6	J3=ROFF(RB)
	R4=RW
11	JY=JY-J5X*JX
C TO GET NEXT NUM OUT OF JY
53	JX=JX/100
50	CONTINUE
55	IF(JTR.NE.99)GO TO 52
	NSAV=NFONT
	GO TO 100

C  FOR TRILLS
C  7, POS1, STF, NT#, SIZE, POS2, X     IF X=1 THEN NO WAVEY LINE
20	RF=R6
	NSAV=NFONT
C SAVE THE FONT NAME.  GET IT BACK AT END.
	JTRILL=J7
	IF(J7.LE.1)GO TO 200
	IF(J7.GE.8)GO TO 201
C JUMP FOR OTTAVA
C  NEXT FOR SPECIAL PEDAL MARKS.

C PEDAL: 7,STF,POS,0=STND POS,NNN=PEDS,POS2,BRACK #S,LFT POS BRK.
C P5=101 MEANS LFT & RT PEDS., P7=2 NO BRK, =3 --!, =4 ----
	RW=R8
	RB=R3
	NFONT=J7
	JY=J5
	CALL NOZERO(R9)
	RY=R9
	RX=23.84*R9*RSTJ2
	R6=.45*RY
	J9=0
	J5=18
C  IN FILE CLEF1.DMD
	JA=3
	R5=0
	R7=0
	R4=R4-6
C  STANDARD POS IS AT -6 ******  (I.E. P4=0 PUTS TOP OF IT AT -6)
	CALL CLEFS
	R8=0
	IF(JY.EQ.0)GO TO 222
	R8=-1
	J5=19
	IF(JY.LT.100)GO TO 203
	JY=JY-100
	CALL CLEFS
203	R3=RB+RX
	IF(JY.LT.10)GO TO 204
	JY=JY-10
	CALL CLEFS
204	R3=RB+RX+RX
	IF(JY.NE.0)CALL CLEFS
C PRINTS THE 3 BOTTOM ITEMS

222	IF(NFONT.EQ.2)GO TO 2222
	IF(RW.NE.0)R3=RB-5.96*RW
C  FOR BRACKET
	RX=POS
	R6=RF
	R4=R4+3.
	R5=R4
	J7=0
	R7=0
	R8=0
	R10=0
206	CALL ITMSUB
	IF(NFONT.EQ.4)GO TO 2222
C  R7=4= NO END ON BRKT.
	IF(NFONT.EQ.5)GO TO 2206
	OLDY=10.*RY*RSTJ2
C THIS WILL BE VERTICAL PART OF BRACK. END.
C THE  COORD. FROM LAST LINES CALL
	CALL LINES(OLDX,OLDY,2)
C OLDX WAS LAST X COORD. IN ITMSUB **************
	GO TO 2222
CZ	POS=RX
C  POS GOT RUINED IN ITMSUB.
CZ	R3=ROFF(RHORZ(RF))
CZ	R5=R5+1.4*RY
CZ	CALL ITMSUB
CZ	RETURN

2206	RARR=2.25*RY*RSTJ2
	R4=R4+2.12
	JA=4
	J5=50
C  FOR CRESC.
	RYY=1.29*RY
	R6=RF
	R3=(R6-RARR)*5.96-596.
	R7=-RYY
	CALL ITMSUB
C GO DRAW CRESC.
	GO TO 2222
C  NEXT FOR 8VA BASSA
202	R7=47717088.
	R8=88709999.
	RR10=138.
	R6=51089170.
	GO TO 214
201	CALL NOZERO(R5)
	IF(J7.EQ.15)GO TO 205
	R6=51089170.
C NEXT = 8VA
	RR10=47.
	R7=99999999.0
214	RR5=R5*RSTJ2
	RR3=R3+RR10*RR5
C  SAVE FOR POS. OF DASHES
	JTR=-1
	J4=J7
	J10=J8
C SAVE THESE IN PARAMS NOT USED IN ALPHA
	GO TO 2212

C  15MA - - - - -
205	R6=51010582.
	R7=70999999.
	RR10=56.
	GO TO 214

C NEXT FOR THE DASHES. J8=1 =NO END BRACK.
213	R8=1.8*RR5
	R9=0
	R3=RR3
	R6=RF
	R4=R4+.7*RSTJ2
	R5=R4
	J5=J4
	J11=-1
	IF(J4)J11=-J11
	IF(J10.NE.0)J11=0
	J7=1
	J10=0
C  GO DRAW THE DASHES
	CALL ITMSUB
	GO TO 2222

200	CALL NOZERO(R5)
	IF(J7.EQ.-8)GO TO 202
	RR10=R5
C  ↑↑↑↑↑ R10 GETS WIPED OUT IN ALPHA OR CLEFS.
	J3=J3+6.*RSTJ2
	JR3=J3
	R6=51898799.0
C  @tr  LWR CASE, ITAL.  TR
	R7=0
	R8=R7
	JTR=J7
2212	R5=.8*R5
	GO TO 54
52	J5=R8
C FOR ACCI OVER TR
	K=POS
C  SAVE POS IN K FOR ACCI ROUTINE
	IF(JTR.NE.0)GO TO 1000
C   GO TO 100 IF NO WAVY LINE IS NEEDED. J7=1=NO, 0=YES
	R3=JR3+20.*RSTJ2*RR10
	JA=4
	J7=-2
C  J7 IS SWITCH TO DRAW WIGGLE
	R6=RF
	R9=.7*RR10
C  SETS WIGGLE HEIGHT
	R8=.9*RR10
C  RR10 IS SIZE (P5)
	J10=0
	IF(IPLT.LT.0)J10=1
	CALL ITMSUB
C  SINGLE WIGGLE ON DPY, DOUBLE ON PLOTTER.
1000	IF(JTRILL.LT.0.OR.JTRILL.GT.1)GO TO 100
C NEXT PUTS ACCI OVER TR IF 1, 2 OR 3 IN P8
C IF JTRILL(J7)=0 OF 1 IT'S A TRILL, ELSE GO TO 2222
C IF R8=0 GOTO 2222 (R8 HAS ACCI NUM)
	IF(R8.EQ.0)GO TO 100
	POS=K
C GET BACK POS. (IT GOT CHANGED IN "WIGGLE")
	CENTR=CENTR+27.*RSTJ2
	R6=R5*.9
	R3=J3-14.*RSTJ2
	R4=R4+3.75
	R7=0
	R8=0
	R9=0
	JA=9
C NOW GO MAKE AN ACCI.
	CALL NOTWRT
100	IF(JTR.LT.0)GO TO 213
	IF(KFNT.LT.0)IFNT=1
	KFNT=0
2222	NFONT=NSAV
C GET BACK ORIGINAL FONT NAME
	END